home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / AMOSPRO5.DMS / in.adf / Fileo'fax.AMOS / Fileo'fax.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1992-09-30  |  37.6 KB  |  1,404 lines
  1. ' ***************************************************************************
  2. ' *                                                                         *
  3. ' *                            AMOS PROFESSIONAL                            *
  4. ' *                            -----------------                            *  
  5. ' *                                                                         *
  6. ' *                           FILOFAX Version 1.1                           *  
  7. ' *                                                                         *
  8. ' *                   Designed & Written by Stuart Davis.                   *
  9. ' *                                                                         *
  10. ' *                Copyright (c) 1992 Europress Software Ltd.               *
  11. ' *                                                                         *
  12. ' ***************************************************************************
  13. '
  14. '
  15. '
  16. ' Filofax internal revision 1.4, last updated on 23rd September, 1992  
  17. '
  18. ' Program written by Stuart Davis. 
  19. '
  20. ' Graphics by Stuart Davis.
  21. '
  22. '
  23. ' ***************************************************************************
  24. Close Editor 
  25. '
  26. ' ---------------- 
  27. ' Dimension arrays 
  28. ' ---------------- 
  29. '  
  30. Dim C0LS(15),BCOORDS(10,2),FD(19,4),KB$(5),WORK$(19),EN$(3),STARDATA(31,1)
  31. Dim _FNAME$(18)
  32. '
  33. ' -----------------------
  34. ' Define global variables
  35. ' -----------------------
  36. '
  37. Global CARDS,CURR_CARD,_MAX_CARDS,CARD_BASE,PNTR_BASE,CANCEL,MBP,CURR_FIELD
  38. Global FILENAME$,MOVE,UNSAVED,FIND$,CURR_PNTR,M$,MEM_RESERVED,STCOUNT
  39. Global STX,STY,STWAIT,RF
  40. '
  41. Global C0LS(),BCOORDS(),FD(),KB$(),WORK$(),EN$(),STARDATA(),_FNAME$()
  42. '
  43. ' Variables for screen scrolling for those poor old NTSC Amigas
  44. '
  45. Global CHNGETV_SCROLLSTART,SCRHEIGHT,T,CTV
  46. '
  47. ' -----------------------
  48. ' Assign global variables
  49. ' -----------------------
  50. '
  51. ' AMERICAN NTSC addition: Scroll values for screen scrolling 
  52. '
  53. CHNGETV_SCROLLSTART=230 : Rem Hardware line at which scrolling starts
  54. SCRHEIGHT=56 : Rem           Number of lines to scroll
  55. '
  56. '
  57. '
  58. ' Keyboard input strings. Used to make one string of allowable characters. 
  59. '
  60. KB$(0)="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
  61. KB$(1)="0123456789"
  62. KB$(2)="( )"
  63. KB$(3)="/"
  64. KB$(4)="."
  65. KB$(5)="!�$%^&*_+|-=\[]{};#:@,/<>?����w'`~"+Chr$(33)
  66. '
  67. EN$(0)="Disc full up!"
  68. EN$(1)="Your disc is write protected."
  69. EN$(2)="There is no disc in the drive"
  70. EN$(3)="An error has occurred!"
  71. '
  72. STCOUNT=23
  73. '
  74. M$="Stop! You have unsaved work. Are your sure you want to proceed?"
  75. '
  76. ' Read field names into array for use when printing cards. 
  77. '
  78. For COUNT=0 To 18
  79.    Read _FNAME$(COUNT)
  80. Next 
  81. '
  82. '
  83. '
  84. ' Read icon positions. Icon positions are stored in data statements. 
  85. ' To be really efficient, initially read them into a bank, then access the 
  86. ' bank (which would be saved with the program).
  87. '
  88. '
  89. For COUNT=O To 10
  90.    Read BCOORDS(COUNT,1)
  91.    Read BCOORDS(COUNT,2)
  92. Next 
  93. '
  94. '--------------------------------------
  95. '
  96. ' Initialize Field Data array (storing data on field position, size & type). 
  97. '
  98. C=5
  99. For COUNT=1 To 7 : Rem         Field data 
  100.    FD(COUNT,1)=15
  101.    FD(COUNT,2)=C
  102.    FD(COUNT,3)=30
  103.    FD(COUNT,4)=1
  104.    Add C,2
  105. Next 
  106. '
  107. For COUNT=8 To 19
  108.    For INDEX=1 To 4
  109.       Read FD(COUNT,INDEX)
  110.    Next 
  111. Next 
  112. '
  113. ' Initialize Star Data array (Storing coords for stars)  
  114. '
  115. '
  116. For COUNT=0 To 31
  117.    Read STARDATA(COUNT,0)
  118.    Read STARDATA(COUNT,1)
  119. Next 
  120. '
  121. '
  122. ' ---------------
  123. ' Data statements
  124. ' ---------------
  125. '
  126. ' Field names
  127. '
  128. Data "SURNAME","FIRST NAMES","STREET","TOWN","CITY","COUNTY","POSTCODE"
  129. Data "D.O.B.","AGE","SEX","COLOUR","WEIGHT","HEIGHT","NATIONALITY","CAR"
  130. Data "PHONE HOME","PHONE WORK","HOBBIES & INTERESTS","COMMENTS"
  131. '
  132. ' Icon position data 
  133. '
  134. Data 44,225,117,225,171,225,243,225,383,223,383,235,506,228,574,228
  135. Data 305,225,374,228,440,228
  136. '
  137. ' Field data (8 to 19) 
  138. '
  139. Data 53,5,8,3
  140. Data 69,5,2,5
  141. Data 53,7,6,1
  142. Data 69,7,7,1
  143. Data 53,9,6,2
  144. Data 69,9,5,2
  145. Data 57,11,19,1
  146. Data 53,13,23,1
  147. Data 58,15,18,4
  148. Data 58,17,18,4
  149. Data 23,19,53,1
  150. Data 15,21,61,1
  151. '
  152. '
  153. ' Stardata 
  154. '
  155. Data 31,214,99,214,167,214,235,214,303,214,371,214,439,214,507,214,575,214
  156. Data 60,230,128,230,196,230,264,230,332,230,400,230,468,230,536,230,604,230
  157. Data 46,180,72,180,133,180,193,180,253,180,314,180,374,180,435,180,495,180
  158. Data 556,180,582,180,541,236,503,4,567,13
  159. '
  160. '
  161. ' -------------
  162. ' Main routines
  163. ' -------------
  164. '
  165. Procedure PREV_CARD
  166.   OP_BUT[1,True] : Rem                 Light button.
  167.   Timer=0 : Rem                        Reset timer.
  168.   Gosub GO : Rem                       Goto previous card.
  169.   While Timer<=15 and(Mouse Key>0 or Key State(79)) : Rem  Time delay. 
  170.   Wend 
  171.   If Timer>=15 : Rem                   After delay, is mouse key still pressed? 
  172.     Repeat : Rem                       Continue to GO while mouse button  
  173.       Gosub GO : Rem                   (or key) is pressed. 
  174.     Until Mouse Key=0 and Not(Key State(79))
  175.   End If 
  176.   OP_BUT[1,False] : Rem                Unlight button. 
  177.   Pop Proc
  178.   '
  179.   GO:
  180.   If CURR_CARD>1
  181.     Dec CURR_CARD
  182.     DISPLAY_CARD
  183.   End If 
  184.   Return 
  185. End Proc
  186. Procedure NXT_CARD
  187.   '
  188.   ' Operation is identical to above procedure. 
  189.   '
  190.   OP_BUT[2,True]
  191.   Timer=0
  192.   Gosub GO
  193.   While Timer<=15 and(Mouse Key>0 or Key State(78))
  194.   Wend 
  195.   If Timer>=15
  196.     Repeat 
  197.       Gosub GO
  198.     Until Mouse Key=0 and Not(Key State(78))
  199.   End If 
  200.   OP_BUT[2,False]
  201.   Pop Proc
  202.   '
  203.   GO:
  204.   If CURR_CARD<CARDS
  205.     Inc CURR_CARD
  206.     DISPLAY_CARD
  207.   End If 
  208.   Return 
  209.   '
  210. End Proc
  211. Procedure FIRST_CARD
  212.   OP_BUT[3,True]
  213.   WATE_NOMOUSE
  214.   If CARDS>0
  215.     CURR_CARD=1
  216.     DISPLAY_CARD
  217.   End If 
  218.   OP_BUT[3,False]
  219. End Proc
  220. Procedure LAST_CARD
  221.   OP_BUT[4,True]
  222.   WATE_NOMOUSE
  223.   If CARDS>0
  224.     CURR_CARD=CARDS
  225.     DISPLAY_CARD
  226.   End If 
  227.   OP_BUT[4,False]
  228. End Proc
  229. Procedure NEW_CARD
  230.   OP_BUT[9,True]
  231.   WATE_NOMOUSE
  232.   If Not MEM_RESERVED
  233.     RESERVE_MEMORY
  234.   End If 
  235.   '
  236.   If CARDS<_MAX_CARDS
  237.     Change Mouse 3 : Rem               Busy pointer.
  238.     Inc CARDS : Rem                    Increment number of cards in file.
  239.     CURR_CARD=CARDS : Rem              We are going to edit this new card. 
  240.     CLR_DISPLAY : Rem                  Blank this new card.
  241.     For COUNT=1 To 19
  242.       WORK$(COUNT)=Space$(FD(COUNT,3)) : Rem  Initialize our work space.
  243.     Next 
  244.     UDATE_CN : Rem                     Update the card number.
  245.     Change Mouse 1 : Rem               Normal pointer.
  246.     ED_CARD[False,0] : Rem             Edit the card. 
  247.     _ADD_CARD : Rem                  Add this to our data structure in 
  248.     'error - no more cards available 
  249.   End If 
  250.   '
  251.   '
  252.   OP_BUT[9,False]
  253. End Proc
  254. Procedure ED_CARD[EDTING,CURR_FIELD]
  255.    Every Off 
  256.    T=True
  257.    Screen Offset 0,0,0
  258.    If CARDS>0 : Rem                     Make sure we have got a card to edit!
  259.       UNSAVED=True
  260.       Pen 1
  261.       Paper 14
  262.       While(CURR_FIELD<19 or MOVE<>0) and Not CANCEL
  263.          If MOVE=0
  264.             Inc CURR_FIELD : Rem           edit the next field  
  265.          Else 
  266.             Add CURR_FIELD,MOVE : Rem      User press up or down arrow so
  267.             If CURR_FIELD<1 : Rem          act accordingly.
  268.                CURR_FIELD=19
  269.             Else 
  270.                If CURR_FIELD>19
  271.                   CURR_FIELD=1
  272.                End If 
  273.             End If 
  274.          End If 
  275.          TYPE=FD(CURR_FIELD,4) : Rem      Set some temporary variables. 
  276.          X=FD(CURR_FIELD,1)
  277.          Y=FD(CURR_FIELD,2)
  278.          Ink 1
  279.          Draw X*8,Y*8+8 To X*8+FD(CURR_FIELD,3)*8,Y*8+8
  280.          '       Highlight line 
  281.          '
  282.          If TYPE=1 : Rem Text strings (all characters)
  283.             RSTRING[WORK$(CURR_FIELD),X,Y,FD(CURR_FIELD,3),%111111]
  284.             WORK$(CURR_FIELD)=Param$
  285.          Else 
  286.             If TYPE=2 : Rem Numbers (digits + decimal point) 
  287.                RSTRING[WORK$(CURR_FIELD),X,Y,FD(CURR_FIELD,3),%10010]
  288.                WORK$(CURR_FIELD)=Param$
  289.             Else 
  290.                If TYPE=3
  291.                   Repeat : Rem Dates (digits and slashes) 
  292.                      RSTRING[WORK$(CURR_FIELD),X,Y,FD(CURR_FIELD,3),%1010]
  293.                      WORK$(CURR_FIELD)=Param$
  294.                      _VALID_DATE[Param$] : Rem Check the date is valid
  295.                   Until Param or(WORK$(CURR_FIELD)="")
  296.                Else 
  297.                   If TYPE=4 : Rem Telephone numbers (digits & brackets)
  298.                      RSTRING[WORK$(CURR_FIELD),X,Y,FD(CURR_FIELD,3),%110]
  299.                      WORK$(CURR_FIELD)=Param$
  300.                   Else 
  301.                      ' Ages (digits only) 
  302.                      '
  303.                      RSTRING[WORK$(CURR_FIELD),X,Y,FD(CURR_FIELD,3),%10]
  304.                      WORK$(CURR_FIELD)=Param$
  305.                   End If 
  306.                End If 
  307.             End If 
  308.          End If 
  309.          WORK$(CURR_FIELD)=WORK$(CURR_FIELD)+Space$(FD(CURR_FIELD,3)-Len(WORK$(CURR_FIELD)))
  310.          Ink 15
  311.          Draw X*8,Y*8+8 To X*8+FD(CURR_FIELD,3)*8,Y*8+8
  312.          ' Black line 
  313.          '
  314.          If MBP : Rem                     Mouse button pressed 
  315.             If Mouse Zone>0
  316.                CANCEL=True
  317.             Else 
  318.                MBP=False
  319.                MX=X Text(X Screen(X Mouse)) : Rem  Get mouse text coords   
  320.                MY=Y Text(Y Screen(Y Mouse))
  321.                IS_IT_A_FIELD[MX,MY] : Rem     Is is a field?   
  322.                If Param>0
  323.                   CURR_FIELD=Param-1 : Rem     Yes, so edit that field  
  324.                Else 
  325.                   Dec CURR_FIELD : Rem         Otherwise, stay on current field -   
  326.                End If : Rem                   (dec curr_field as it will be  
  327.             End If 
  328.          End If : Rem                      incremented at the top of the loop).  
  329.          '
  330.       Wend 
  331.       CANCEL=False
  332.       If EDTING
  333.          REPLACE_CARD[CURR_CARD]
  334.       End If 
  335.    End If 
  336.    Every On : Rem FL was ere 
  337. End Proc
  338. Procedure S0RT[UP]
  339.   OP_BUT[10,True]
  340.   If UP
  341.     OP_BUT[5,True]
  342.   Else 
  343.     OP_BUT[6,True]
  344.   End If 
  345.   WATE_NOMOUSE
  346.   If CARDS>1
  347.     '
  348.     ' Simple "Bubble" sort on pointers in bank 8.
  349.     ' this sort works best on a data that is "nearly" sorted, so 
  350.     ' it is best to perform a sort regularly.
  351.     '
  352.     ' It would be even better to incorporate an automatic sort every time
  353.     ' a new card is inserted. This would ensure the filofax remains sorted.
  354.     '
  355.     Change Mouse 3
  356.     Repeat 
  357.       S0RTED=True
  358.       For C=CARDS-1 To 1 Step -1 : Rem     Work from the bottom to the top, just like a bubble! 
  359.         EXTRACT_FIELD[C,1]
  360.         If UP
  361.           HIGH$=Upper$(Param$)
  362.           PHIGH=CURR_PNTR
  363.         Else 
  364.           LOW$=Upper$(Param$)
  365.           PLOW=CURR_PNTR
  366.         End If 
  367.         EXTRACT_FIELD[C+1,1]
  368.         If UP
  369.           LOW$=Upper$(Param$)
  370.           PLOW=CURR_PNTR
  371.         Else 
  372.           HIGH$=Upper$(Param$)
  373.           PHIGH=CURR_PNTR
  374.         End If 
  375.         If LOW$<HIGH$ : Rem            Compare two adjacent cards. 
  376.           S0RTED=False : Rem           Swap if they are not in order. 
  377.           TMP=Leek(PHIGH)
  378.           Loke PHIGH,Leek(PLOW)
  379.           Loke PLOW,TMP
  380.         End If 
  381.       Next 
  382.     Until S0RTED
  383.     Change Mouse 1
  384.     DISPLAY_CARD
  385.   Else 
  386.     MESSAGE["There are no cards to sort!","OK","OK",False]
  387.   End If 
  388.   OP_BUT[10,False]
  389.   OP_BUT[5,False]
  390.   OP_BUT[6,False]
  391. End Proc
  392. Procedure FIND
  393.   Every Off 
  394.   OP_BUT[11,True]
  395.   WATE_NOMOUSE
  396.   If CARDS>0
  397.     Get Block 1,24,216,608,37
  398.     Ink 15
  399.     Bar 46,216 To 599,251 : Rem            Draw box
  400.     Ink 0
  401.     Bar 48,217 To 597,250
  402.     Ink 2 : Rem                           Draw text box. 
  403.     Bar 268,222 To 516,232
  404.     Ink 15
  405.     Bar 270,223 To 514,231
  406.     '
  407.     '
  408.     Locate 19,28
  409.     Pen 2
  410.     Paper 0
  411.     Wait Vbl 
  412.     Print "Text to find"
  413.     Pen 1
  414.     Paper 15
  415.     Locate 34,28
  416.     Print FIND$
  417.     '
  418.     BUTTON[False,60,234,80,12,"OK"] : Rem  Draw buttons  
  419.     BUTTON[False,268,234,112,12,"Find Previous"]
  420.     BUTTON[False,400,234,112,12,"Find Next"]
  421.     Set Zone 1,60,234 To 140,246
  422.     Set Zone 2,268,234 To 380,246
  423.     Set Zone 3,400,234 To 512,246
  424.     Set Zone 4,268,222 To 516,232
  425.     '
  426.     Repeat 
  427.       If MBP : Rem                       Deal with "Superactivity"
  428.         MBP=False
  429.       Else 
  430.         Repeat : Rem                     Wait for mouse click.  
  431.           Multi Wait 
  432.         Until Mouse Click
  433.       End If 
  434.       MBOX=Mouse Zone
  435.       If MBOX=1
  436.         BUTTON[True,60,234,80,12,"OK"]
  437.         OK=True
  438.       Else 
  439.         If MBOX=2
  440.           BUTTON[True,268,234,112,12,"Find Previous"]
  441.           If CURR_CARD>1
  442.             WATE_NOMOUSE
  443.             Change Mouse 3
  444.             For COUNT=CURR_CARD-1 To 1 Step -1 : Rem look at previous cards.
  445.               For F=1 To 19
  446.                 EXTRACT_FIELD[COUNT,F] : Rem           Extract next surname.
  447.                 NOSPACE[Param$]
  448.                 If Instr(Param$,FIND$)
  449.                   CURR_CARD=COUNT : Rem    Go to matching card.  
  450.                   EXTRACT_CARD[CURR_CARD] : Rem  Retreive that card... 
  451.                   DISPLAY_CARD : Rem             and display it.
  452.                   Exit 2 : Rem    Slap Wrists! - A Repeat ... Until loop would  
  453.                 End If : Rem      have been more structured, but this is an 
  454.               Next : Rem          example of the exit command!  
  455.             Next 
  456.             If COUNT=0
  457.               Bell : Rem         There are no more matching cards.
  458.             End If 
  459.           Else 
  460.             Bell : Rem           We are already at the first card.  
  461.           End If 
  462.           Change Mouse 1
  463.           BUTTON[False,268,234,112,12,"Find Previous"]
  464.         Else 
  465.           If MBOX=3
  466.             BUTTON[True,400,234,112,12,"Find Next"] : Rem this section is
  467.             If CURR_CARD<CARDS : Rem                  identical to that above.
  468.               WATE_NOMOUSE
  469.               Change Mouse 3
  470.               For COUNT=CURR_CARD+1 To CARDS
  471.                 For F=1 To 19
  472.                   EXTRACT_FIELD[COUNT,F]
  473.                   NOSPACE[Param$]
  474.                   If Instr(Param$,FIND$)
  475.                     CURR_CARD=COUNT
  476.                     EXTRACT_CARD[CURR_CARD]
  477.                     DISPLAY_CARD
  478.                     Exit 2
  479.                   End If 
  480.                 Next 
  481.               Next 
  482.               If COUNT>CARDS
  483.                 Bell 
  484.               End If 
  485.             Else 
  486.               Bell 
  487.             End If 
  488.             Change Mouse 1
  489.             BUTTON[False,400,234,112,12,"Find Next"]
  490.           Else 
  491.             If MBOX=4
  492.               Pen 1
  493.               Paper 15
  494.               RSTRING[FIND$,34,28,30,%111111]
  495.               FIND$=Param$
  496.             End If 
  497.           End If 
  498.         End If 
  499.       End If 
  500.     Until OK
  501.     '
  502.   Else 
  503.     MESSAGE["There is nothing to find!","OK","OK",False]
  504.   End If 
  505.   WATE_NOMOUSE
  506.   ICON_ZONES
  507.   Put Block 1
  508.   OP_BUT[11,False]
  509.   '
  510. End Proc
  511. Procedure EXTRACT_FIELD[CARD_NO,F]
  512.   CURR_PNTR=((CARD_NO-1)*4)+PNTR_BASE : Rem      Calculate pointers. 
  513.   CURR_BASE=Leek(CURR_PNTR)+CARD_BASE
  514.   If F>1
  515.     For L=2 To F
  516.       Add OFFSET,FD(L,3) : Rem         Calculate offset to required field.
  517.     Next 
  518.   End If 
  519.   RESULT$=Space$(FD(F,3)) : Rem        Assign space for the required info. 
  520.   Areg(0)=CURR_BASE+OFFSET : Rem       The start of the surname on the card.    
  521.   Areg(1)=Varptr(RESULT$) : Rem        Start of our storage space. 
  522.   Dreg(0)=30 : Rem                     Length of memory to copy.
  523.   R=Execall(-624) : Rem                Copy the memory into our storage space. 
  524. End Proc[RESULT$]
  525. Procedure DISPLAY_CARD
  526.   EXTRACT_CARD[CURR_CARD] : Rem      Get the current card from the 
  527.   Pen 1 : Rem                          bank and put it in WORK$()  
  528.   Paper 14
  529.   For COUNT=1 To 19
  530.     Locate FD(COUNT,1),FD(COUNT,2)
  531.     Print WORK$(COUNT)
  532.   Next 
  533.   UDATE_CN
  534. End Proc
  535. Procedure RESERVE_MEMORY
  536.   On Error Proc HANDLE_ERROR
  537.   Resume Label RECOVER
  538.   Change Mouse 3
  539.   AVAILMEM[0] : Rem                    Get the largest block of memory.
  540.   _MAX_CARDS=Min(400,(Param-436)/436) : Rem  400 is the maximum number we want.    
  541.   Reserve As Work 6,436*_MAX_CARDS : Rem  Reserve bank 6 for data 
  542.   CARD_BASE=Start(6)+4
  543.   Reserve As Work 8,(_MAX_CARDS*4) : Rem  Reserve bank 8 for pointers 
  544.   PNTR_BASE=Start(8)
  545.   MEM_RESERVED=True
  546.   RECOVER:
  547.   Change Mouse 1
  548. End Proc
  549. Procedure _ADD_CARD
  550.   '
  551.   ' Add a new card to the data structure in bank 6 
  552.   '
  553.   CURR_BASE=(CURR_CARD-1)*436+CARD_BASE : Rem   Calculate pointers 
  554.   CURR_PNTR=((CURR_CARD-1)*4)+PNTR_BASE
  555.   Loke CURR_PNTR,CURR_BASE-CARD_BASE : Rem      Set the pointer 
  556.   '
  557.   _FIELD_OFFSET=0
  558.   For COUNT=1 To 19 : Rem              Loop for each field 
  559.     Areg(0)=Varptr(WORK$(COUNT)) : Rem Start of memory to be moved. 
  560.     Areg(1)=CURR_BASE+_FIELD_OFFSET : Rem  Start of destination. 
  561.     Dreg(0)=Len(WORK$(COUNT)) : Rem    Length of memory to be moved. 
  562.     R=Execall(-624) : Rem              exec library COPY MEM function. 
  563.     Add _FIELD_OFFSET,FD(COUNT,3) : Rem  Start of next field.
  564.   Next 
  565. End Proc
  566. Procedure REPLACE_CARD[CARD_NO]
  567.   '
  568.   ' Return the current card to bank 6 in its correct position. 
  569.   '
  570.   CURR_PNTR=((CARD_NO-1)*4)+PNTR_BASE : Rem Calculate pointers.
  571.   CURR_BASE=Leek(CURR_PNTR)+CARD_BASE
  572.   _FIELD_OFFSET=0
  573.   For COUNT=1 To 19
  574.     Areg(0)=Varptr(WORK$(COUNT)) : Rem  Registers described in above procedure. 
  575.     Areg(1)=CURR_BASE+_FIELD_OFFSET
  576.     Dreg(0)=Len(WORK$(COUNT))
  577.     R=Execall(-624) : Rem               exec library COPY MEM function.  
  578.     Add _FIELD_OFFSET,FD(COUNT,3)
  579.   Next 
  580. End Proc
  581. Procedure EXTRACT_CARD[CARD_NO]
  582.   '
  583.   ' Reverse operation of above procedure.
  584.   '
  585.   CURR_PNTR=((CARD_NO-1)*4)+PNTR_BASE
  586.   CURR_BASE=Leek(CURR_PNTR)+CARD_BASE
  587.   _FIELD_OFFSET=0
  588.   For COUNT=1 To 19
  589.     WORK$(COUNT)=Space$(FD(COUNT,3))
  590.     Areg(0)=CURR_BASE+_FIELD_OFFSET
  591.     Areg(1)=Varptr(WORK$(COUNT))
  592.     Dreg(0)=FD(COUNT,3)
  593.     R=Execall(-624)
  594.     Add _FIELD_OFFSET,FD(COUNT,3)
  595.   Next 
  596. End Proc
  597. Procedure DEL_CARD
  598.   If CARDS>0
  599.     MESSAGE["Discard this card?","Discard","NO!",True]
  600.     If Param
  601.       If CARDS=1
  602.         CLEAR
  603.       Else 
  604.         CURR_PNTR=((CURR_CARD-1)*4)+PNTR_BASE
  605.         CURR_BASE=Leek(CURR_PNTR)+CARD_BASE
  606.         Areg(0)=CURR_BASE+436
  607.         Areg(1)=CURR_BASE
  608.         Dreg(0)=CARD_BASE+(CARDS*436)-CURR_BASE
  609.         R=Execall(-624)
  610.         Areg(0)=CURR_PNTR+4
  611.         Areg(1)=CURR_PNTR
  612.         Dreg(0)=PNTR_BASE+(CARDS*4)-PNTR_BASE
  613.         R=Execall(-624)
  614.         Dec CARDS
  615.         CURR_CARD=Min(CARDS,CURR_CARD)
  616.         For CDS=1 To CARDS
  617.           CURR_PNTR=((CDS-1)*4)+PNTR_BASE
  618.           If Leek(CURR_PNTR)>CURR_BASE-CARD_BASE
  619.             Loke CURR_PNTR,Leek(CURR_PNTR)-436
  620.           End If 
  621.         Next 
  622.       End If 
  623.     End If 
  624.     If CARDS>0
  625.       DISPLAY_CARD
  626.     End If 
  627.   Else 
  628.     MESSAGE["You have no cards!","OK","OK",False]
  629.   End If 
  630. End Proc
  631. Procedure CLEAR_CARDS
  632.   If CARDS>0
  633.     If UNSAVED
  634.       MESSAGE[M$,"Yes","No",True]
  635.     Else 
  636.       MESSAGE["Clear all cards.","Proceed","Cancel",False]
  637.     End If 
  638.     If Param
  639.       CLEAR
  640.     End If 
  641.   Else 
  642.     MESSAGE["You cave no cards to clear!","OK","OK",False]
  643.   End If 
  644. End Proc
  645. Procedure PCARD[ALL]
  646.   On Error Goto SMEG
  647.   If CARDS>0 : Rem                     Only print if there is something to print! 
  648.     Change Mouse 3 : Rem               Busy mouse 
  649.     Open Port 1,"PRT:" : Rem           Open printer driver driven printer 
  650.     If ALL : Rem                       If ALL cards are to be printed...
  651.       FIRST=1
  652.       LAST=CARDS
  653.     Else 
  654.       FIRST=CURR_CARD
  655.       LAST=CURR_CARD
  656.     End If 
  657.     Print #1,String$("-",80) : Rem     Line of dotted lines 
  658.     For COUNT=FIRST To LAST
  659.       X$=Inkey$
  660.       If X$=Chr$(27) : Rem             Test for escape key and abort printing 
  661.         Bell : Rem                    if pressed. 
  662.         Exit 
  663.       End If 
  664.       EXTRACT_CARD[COUNT] : Rem       get card to be printed.
  665.       BOLD_ON
  666.       Print #1,"CARD NUMBER";COUNT : Rem  Print the card number of card being printed 
  667.       BOLD_OFF
  668.       Print #1,String$("-",80)
  669.       OFFSET=7 : Rem                   Offset to next field to be printed on
  670.       For L=0 To 6 : Rem               this line
  671.         X$=Inkey$
  672.         If X$=Chr$(27) : Rem           Another test for escape key
  673.           Bell 
  674.           Exit 2
  675.         End If 
  676. '
  677. '       Left field column
  678. '
  679.         BOLD_ON
  680.         Print #1,Space$(11-Len(_FNAME$(L)))+_FNAME$(L);
  681.         BOLD_OFF
  682.         Print #1," "+WORK$(L+1);
  683. '
  684. '       Right field column 
  685. '
  686.         BOLD_ON
  687.         Print #1,Space$(12-Len(_FNAME$(L+OFFSET)))+_FNAME$(L+OFFSET);
  688.         BOLD_OFF
  689.         Print #1," "+WORK$(L+1+OFFSET);
  690. '
  691. '       Farthest right field column (AGE, COLOUR, HEIGHT)
  692. '
  693.         If L+OFFSET<=12
  694.           If L+OFFSET+1=10 or L+OFFSET+1=12
  695.             Print #1,"  ";
  696.           End If 
  697.           BOLD_ON
  698.           Print #1,Space$(9-Len(_FNAME$(L+OFFSET+1)))+_FNAME$(L+OFFSET+1);
  699.           BOLD_OFF
  700.           Print #1," "+WORK$(L+2+OFFSET)
  701.           Inc OFFSET
  702.         Else 
  703.           Print #1,Chr$(13)
  704.         End If 
  705.         Print #1,Chr$(13)
  706.       Next 
  707. '
  708. '     Last 2 fields
  709. '
  710.       BOLD_ON
  711.       Print #1,_FNAME$(17);
  712.       BOLD_OFF
  713.       Print #1," "+WORK$(18)
  714.       Print #1,Chr$(13)
  715.       BOLD_ON
  716.       Print #1,_FNAME$(18);
  717.       BOLD_OFF
  718.       Print #1," "+WORK$(19)
  719.       BOLD_OFF
  720.       Print #1,String$("-",80)
  721.     Next 
  722.     Close 1
  723. ER:
  724.     EXTRACT_CARD[CURR_CARD] : Rem      Restore WORKS$ to card that is being
  725.     Change Mouse 1 : Rem               displayed. 
  726.   Else 
  727.     MESSAGE["There is nothing to print!","Whoops!","Whoops!",False]
  728.   End If 
  729. Pop Proc
  730. '
  731. SMEG:
  732. MESSAGE["I/O ERROR! Check printer & cables","OK","OK",True]
  733. Close 
  734. Resume ER
  735. End Proc
  736. Procedure BOLD_ON
  737.   Print #1,Chr$(27);"[1m";
  738. End Proc
  739. Procedure BOLD_OFF
  740.   Print #1,Chr$(27);"[22m";
  741. End Proc
  742. Procedure CLEAR
  743.   '
  744.   ' Initilize variables
  745.   '
  746.   CURR_CARD=0
  747.   CARDS=0
  748.   _MAX_CARDS=0
  749.   MEM_RESERVED=False
  750.   CLR_DISPLAY
  751.   Erase 6
  752.   Erase 8
  753. End Proc
  754. '
  755. ' ---------------
  756. ' Filing routines
  757. ' ---------------
  758. '
  759. Procedure RMOVE_EXT[WORD$]
  760.   '
  761.   ' Remove the . extension from passed string. 
  762.   '
  763.   If Right$(WORD$,4)=".FLX" or(Right$(WORD$,4)=".FNX")
  764.     WORD$=Left$(WORD$,(Len(WORD$)-4))
  765.   End If 
  766. End Proc[WORD$]
  767. Procedure NAME_FROM_PATH[P$]
  768.   '
  769.   ' Return the file name from the path name
  770.   '
  771.   F$=Right$(P$,(Len(P$)-(Instr(P$,":"))))
  772.   If Instr(F$,"/")
  773.     X=Len(F$)
  774.     Repeat 
  775.       Dec X
  776.     Until Mid$(F$,X,1)="/"
  777.     F$=Right$(F$,Len(F$)-X)
  778.   End If 
  779. End Proc[F$]
  780. Procedure _LOAD
  781.   On Error Proc HANDLE_ERROR
  782.   Resume Label RECOVER
  783.   OP_BUT[7,True]
  784.   WATE_NOMOUSE
  785.   GO=True
  786.   '
  787.   If UNSAVED
  788.     MESSAGE[M$,"Yes","No",True]
  789.     GO=Param
  790.   End If 
  791.   If GO
  792.     ' Get the filename to load.
  793. T=True
  794.   Screen Offset 0,0,0
  795.     FILENAME$=Fsel$(Dir$+"*.FNX","","Load a","FILE O' FACTS file")
  796.     If FILENAME$<>"" : Rem               Only load if filename given. 
  797.       Change Mouse 3
  798.       RMOVE_EXT[FILENAME$]
  799.       CLEAR : Rem                        We are loading a new card file, so
  800.       F$=Param$+".FLX"+Chr$(0) : Rem     clear the old one out. 
  801.       Dreg(1)=Varptr(F$) : Rem           OPEN file
  802.       Dreg(2)=1005 : Rem                 for READING
  803.       FILE_HANDLE=Doscall(-30) : Rem     Pointer to dos file handle 
  804.       If FILE_HANDLE>0 : Rem             If file was opened successfully... 
  805.         '  
  806.         ' Read the number of cards in the file 
  807.         '
  808.         Dreg(1)=FILE_HANDLE
  809.         Dreg(2)=Varptr(CARDS) : Rem      Put value read into variable cards  
  810.         Dreg(3)=4 : Rem                  We want to read first FOUR bytes  
  811.         AMOUNT_READ=Doscall(-42) : Rem   Do the read  
  812.         If AMOUNT_READ=4 : Rem           Make sure everything was all right 
  813.           RESERVE_MEMORY
  814.           If _MAX_CARDS>=CARDS : Rem     Then we have room to load the file 
  815.             Dreg(1)=FILE_HANDLE
  816.             Dreg(2)=Start(6)+4
  817.             Dreg(3)=CARDS*436 : Rem      Read rest of file into bank 6.
  818.             AMOUNT_READ=Doscall(-42) : Rem  Do the read   
  819.             NF$=Param$+".FNX"
  820.             If Exist(NF$)
  821.               Bload NF$,Start(8) : Rem    load the index file (pointers). 
  822.             End If 
  823.             CURR_CARD=1 : Rem            Initialize then display first card. 
  824.             DISPLAY_CARD
  825.             UNSAVED=False
  826.           Else 
  827.             MESSAGE["There is not enough memory to load your file.","OK","OK",False]
  828.             CLEAR: Rem                  Not enough memory, so keep cleared! 
  829.           End If 
  830.         End If 
  831.         Dreg(1)=FILE_HANDLE : Rem       CLOSE the file   
  832.         FILE_HANDLE=Doscall(-36)
  833.       Else 
  834.         'error: No file handle - couldn't open file. 
  835.         MESSAGE["Could not open file.","Continue","Continue",False]
  836.       End If 
  837.       RECOVER:
  838.       Change Mouse 1
  839.     End If 
  840.   End If 
  841.   OP_BUT[7,False]
  842. End Proc
  843. Procedure _SAVE
  844.   On Error Proc HANDLE_ERROR
  845.   Resume Label RECOVER
  846.   OP_BUT[8,True]
  847.   WATE_NOMOUSE
  848.   If CARDS>0 : Rem                     Only proceed if we have at least one card
  849.     Loke Start(6),CARDS : Rem          Store the number of cards at the start  
  850.     '                                      of the bank.
  851.     NAME_FROM_PATH[FILENAME$]
  852. T=True
  853.   Screen Offset 0,0,0
  854.     F$=Fsel$(Dir$+"*.FNX",Param$,"Save your","FILE O' FACTS file")
  855.     If F$<>""
  856.       FILENAME$=F$
  857.       RMOVE_EXT[FILENAME$]
  858.       Change Mouse 3
  859.       F$=Param$+".FLX"
  860.       ' Save our cards in bank 6 and our pointers    
  861.       ' in bank 8.   
  862.       '
  863.       ' Note that pointers and data could be in    
  864.       ' the same bank, but it is easier to   
  865.       ' handle them seperatly to show their use.   
  866.       '
  867.       Bsave F$,Start(6) To Start(6)+4+(436*CARDS)
  868.       F$=Param$+".FNX"
  869.       Bsave F$,Start(8) To Start(8)+(4*CARDS)
  870.       UNSAVED=False
  871.     End If 
  872.   Else 
  873.     MESSAGE["There are no cards to save!","OK","OK",False]
  874.   End If 
  875.   RECOVER:
  876.   OP_BUT[8,False]
  877.   Change Mouse 1
  878. End Proc
  879. '
  880. ' ---------------- 
  881. ' Service routines 
  882. ' ---------------- 
  883. '
  884. Procedure _VALID_DATE[DATE$]
  885.   '
  886.   ' Check that the date passed in DATE$ is valid.
  887.   '
  888.   VD=((Mid$(DATE$,3,1)="/") and(Mid$(DATE$,6,1)="/"))
  889.   If VD
  890.     DAY=Val(Left$(DATE$,2))
  891.     MONTH=Val(Mid$(DATE$,4,2))
  892.     YEAR=Val(Right$(DATE$,2))
  893.     VD[DAY,MONTH,YEAR]
  894.     VD=Param
  895.   End If 
  896. End Proc[VD]
  897. Procedure VD[DAY,MONTH,YEAR]
  898.   '
  899.   ' Check that DAY MONTH and YEAR are valid. 
  900.   '
  901.   _VALID_DAY[DAY,MONTH]
  902.   VD=Param
  903.   LEAP_YEAR[YEAR]
  904.   LP=Param
  905.   If DAY=29 and MONTH=2 and LP
  906.     VD=True
  907.   End If 
  908. End Proc[VD]
  909. Procedure LEAP_YEAR[YEAR]
  910.   '
  911.   ' Is the YEAR a leap year? 
  912.   '
  913.   LP=(YEAR mod 4=0) or(YEAR mod 1000=0)
  914. End Proc[LP]
  915. Procedure _VALID_DAY[DAY,MONTH]
  916.   '
  917.   ' Check the day is within the number of days in the month
  918.   '
  919.   DAYS_IN_MONTH[MONTH]
  920.   VD=(DAY>0) and(DAY<=Param)
  921. End Proc[VD]
  922. Procedure DAYS_IN_MONTH[MONTH]
  923.   '
  924.   ' Return the number of days in the requested month 
  925.   '
  926.   D=0
  927.   MONTH$=Str$(MONTH)
  928.   If Instr(" 1 3 5 7 8 10 12",MONTH$)
  929.     D=31
  930.   Else 
  931.     If Instr(" 4 6 9 11",MONTH$)
  932.       D=30
  933.     Else 
  934.       If MONTH=2
  935.         D=28
  936.       End If 
  937.     End If 
  938.   End If 
  939. End Proc[D]
  940. Procedure NOSPACE[TXT$]
  941.   '
  942.   ' Remove spaces from the end of the passed string. 
  943.   '
  944.   While Right$(TXT$,1)=" "
  945.     TXT$=Left$(TXT$,Len(TXT$)-1)
  946.   Wend 
  947. End Proc[TXT$]
  948. Procedure RSTRING[TXT$,XPOS,YPOS,LMAX,AK]
  949.   '
  950.   ' Read user input into a string. 
  951.   ' TXT$ contains default starting string. 
  952.   ' XPOS & YPOS are the X and Y text positions for the first character 
  953.   ' LMAX in the maximum length of the string 
  954.   ' AK is a flag to indicate the allowable keys. 
  955.   '
  956.   WATE_NOMOUSE
  957.   Clear Key 
  958.   NOSPACE[TXT$]
  959.   TXT$=Param$
  960.   MOVE=0
  961.   CHAR$=""
  962.   For COUNT=0 To 5
  963.     If Btst(COUNT,AK)
  964.       CHAR$=CHAR$+KB$(COUNT)
  965.     End If 
  966.   Next 
  967.   TEMP_INS=1 : Rem 1=Insert, 2=Overwrite
  968.   CANCEL=False
  969.   X=Len(TXT$)
  970.   Repeat 
  971.     Curs Off 
  972.     Locate XPOS,YPOS
  973.     Print TXT$;
  974.     '      Locate 0,0 : Print X,XPOS+LMAX
  975.     If X+XPOS<XPOS+LMAX
  976.       Print " ";
  977.     End If 
  978.     Locate XPOS+X,YPOS
  979.     Curs On 
  980.     Repeat 
  981.       MK=Mouse Key
  982.       KY$=Inkey$
  983.       KY=Scancode
  984.     Until KY$<>"" or(MK=1)
  985.     If KY=65 and X>0
  986.       TXT$=Left$(TXT$,X-1)+Mid$(TXT$,X+1)
  987.       X=Max(0,X-1)
  988.     End If 
  989.     If KY=70
  990.       TXT$=Left$(TXT$,X)+Mid$(TXT$,X+2)
  991.       KY=-1
  992.     End If 
  993.     If KY=79
  994.       X=Max(0,X-1)
  995.       KY=-1
  996.     End If 
  997.     If KY=78
  998.       X=Min(Len(TXT$),X+1)
  999.       KY=-1
  1000.     End If 
  1001.     If Instr(CHAR$,KY$) and KY>0
  1002.       If X<LMAX
  1003.         TXT$=Left$(TXT$,X)+KY$+Mid$(TXT$,X+TEMP_INS)
  1004.         If Len(TXT$)>LMAX
  1005.           TXT$=Left$(TXT$,LMAX)
  1006.         End If 
  1007.         X=Min(LMAX,X+1)
  1008.       End If 
  1009.     End If 
  1010.   Until(KY$=Chr$(13)) or(KY$=Chr$(27)) or(KY$=Chr$(30)) or(KY$=Chr$(31)) or(MK=1)
  1011.   If KY$=Chr$(27)
  1012.     CANCEL=True
  1013.   End If 
  1014.   If KY$=Chr$(30)
  1015.     MOVE=-1
  1016.   End If 
  1017.   If KY$=Chr$(31)
  1018.     MOVE=1
  1019.   End If 
  1020.   MBP=(MK=1)
  1021.   Curs Off 
  1022. End Proc[TXT$]
  1023. Procedure IS_IT_A_FIELD[X,Y]
  1024.   '
  1025.   ' Is there a field at text positions XY. If so, return the field number. 
  1026.   '
  1027.   FOUND=False
  1028.   RT=0
  1029.   For FP=1 To 19
  1030.     If FD(FP,2)=Y
  1031.       If X>=FD(FP,1) and(X<=(FD(FP,1))+FD(FP,3))
  1032.         FOUND=True
  1033.         RT=FP
  1034.         Exit 
  1035.       End If 
  1036.     End If 
  1037.   Next 
  1038.   If Not FOUND Then RT=0
  1039. End Proc[RT]
  1040. Procedure MESSAGE[TXT$,BUT1$,BUT2$,WARN]
  1041. Every Off 
  1042.   Change Mouse 1
  1043.   WATE_NOMOUSE
  1044.   Get Block 1,24,216,608,37
  1045.   If WARN
  1046.     Ink 9
  1047.   Else 
  1048.     Ink 15
  1049.   End If 
  1050.   Bar 46,216 To 599,251 : Rem            Draw box
  1051.   Ink 0
  1052.   Bar 48,217 To 597,250
  1053.   Ink 1,0
  1054.   Text 320-(Len(TXT$)*4),227,TXT$
  1055.   BUTTON[False,60,234,80,12,BUT1$]
  1056.   BUTTON[False,499,234,80,12,BUT2$]
  1057.   Set Zone 1,60,234 To 140,246
  1058.   Set Zone 2,499,234 To 579,246
  1059.   Wait 50
  1060.   Repeat 
  1061.     Repeat 
  1062.       Multi Wait 
  1063.     Until Mouse Click=1 or Key Shift=64 or Key Shift=128
  1064.     If Key Shift=128
  1065.       MBOX=2
  1066.     Else 
  1067.       If Key Shift=64
  1068.         MBOX=1
  1069.       Else 
  1070.         MBOX=Mouse Zone
  1071.       End If 
  1072.     End If 
  1073.     If MBOX=1
  1074.       BUTTON[True,60,234,80,12,BUT1$]
  1075.       RESULT=True
  1076.     Else 
  1077.       If MBOX=2
  1078.         BUTTON[True,499,234,80,12,BUT2$]
  1079.         RESULT=False
  1080.       End If 
  1081.     End If 
  1082.   Until MBOX=1 or MBOX=2
  1083.   WATE_NOMOUSE
  1084.   Repeat 
  1085.   Until Key Shift=0
  1086.   ICON_ZONES
  1087.   Put Block 1
  1088. End Proc[RESULT]
  1089. Procedure WATE_NOMOUSE
  1090.   While Mouse Key<>0
  1091.   Wend 
  1092. End Proc
  1093. Procedure AVAILMEM[X]
  1094.   '
  1095.   'Load D1 WITH 0 For ALL MEM,2 For CHIP MEM and 4 For FAST MEM
  1096.   '
  1097.   Dreg(1)=X+131072 : Rem 2^17 - set bit 17 to receive max block available 
  1098.   RESULT=Execall(-216) : Rem call exec library AVAILMEM function
  1099. End Proc[RESULT]
  1100. Procedure HANDLE_ERROR
  1101.   If Errn=88
  1102.     EN=0
  1103.   Else 
  1104.     If Errn=84
  1105.       EN=1
  1106.     Else 
  1107.       If Errn=93
  1108.         EN=2
  1109.       Else 
  1110.         EN=3
  1111.       End If 
  1112.     End If 
  1113.   End If 
  1114.   MESSAGE[EN$(EN),"OK","OK",True]
  1115.   Resume Label 
  1116. End Proc
  1117. Procedure DUMMY
  1118. End Proc
  1119. '
  1120. ' ---------------- 
  1121. ' Display routines 
  1122. ' ---------------- 
  1123. '
  1124. Procedure BUTTON[LIT,X,Y,W,H,T$]
  1125.   Ink 0
  1126.   Bar X,Y To X+W+2,Y+H+1
  1127.   Ink 13
  1128.   Bar X+4,Y+2 To X+4+W,Y+H+2 : Rem Shadow 
  1129.   If LIT
  1130.     Add X,2
  1131.     Inc Y
  1132.   End If 
  1133.   Ink 15
  1134.   Bar X,Y To X+W,Y+H : Rem Black box
  1135.   Ink 5
  1136.   Bar X+2,Y+1 To X+W-2,Y+H-1 : Rem Grey inside
  1137.   If LIT
  1138.     Ink 12,5
  1139.   Else 
  1140.     Ink 11,5
  1141.   End If 
  1142.   Text X+(W/2)-(Len(T$)*4),Y+9,T$
  1143. End Proc
  1144. Procedure UDATE_CN
  1145.   Ink 1,13
  1146.   If CARDS=0
  1147.     N$="   "
  1148.   Else 
  1149.     N$=Str$(CURR_CARD)-" "
  1150.     N$=String$("0",3-Len(N$))+N$
  1151.   End If 
  1152.     Text 206,24,N$
  1153. End Proc
  1154. Procedure ICON_ZONES
  1155.   '
  1156.   ' Reserve the zones for the icons at bottom of screen
  1157.   '
  1158.   For COUNT=1 To 9
  1159.     Set Zone COUNT-((COUNT>6)),(67*COUNT)-35,220 To(67*COUNT)+7,240
  1160.   Next 
  1161.   Set Zone 6,370,220 To 407,229
  1162.   Set Zone 7,370,230 To 407,240
  1163.   Set Zone 11,548,242 To 564,250
  1164. End Proc
  1165. Procedure STAR
  1166.   If STWAIT<1 : Rem                    Time delay between flashes
  1167.     If STCOUNT=34 : Rem                Reset star icons to start again 
  1168.       STCOUNT=23
  1169.     End If 
  1170.     '
  1171.     If STCOUNT=23 : Rem                We've come full circle so choose new
  1172.       RF=Rnd(70) : Rem                 Random time between flashes
  1173.       ST=Rnd(31) : Rem                 flash position.
  1174.       STX=STARDATA(ST,0)
  1175.       STY=STARDATA(ST,1)
  1176.       Get Block 2,STX,STY,16,14 : Rem  Block to restore screen as it is
  1177.     End If : Rem                       uncovered. 
  1178.     '
  1179.     If STCOUNT<29 : Rem                Paste icon neat.
  1180.       Paste Icon STX,STY,STCOUNT
  1181.     Else 
  1182.       Put Block 2
  1183.       Paste Icon STX,STY,STCOUNT-((STCOUNT-28)*2) : Rem going backwards from 
  1184.     End If : Rem                                        big star to small star
  1185.     Inc STCOUNT : Rem                  Number of star frames 
  1186.   Else 
  1187.     Inc STWAIT : Rem                   Increment wait between stars counter 
  1188.   End If 
  1189.   If STCOUNT=34 : Rem                  remove last frame 
  1190.     Inc STWAIT
  1191.     Put Block 2
  1192.   End If 
  1193.   If STWAIT>=RF : Rem                  Reset after random delay time 
  1194.     STWAIT=0
  1195.   End If 
  1196.   '
  1197.   Every On 
  1198. End Proc
  1199. Procedure OP_BUT[BUT,LIT]
  1200.   '
  1201.   ' Illuminate the buttons. BUT is button to affect, LIT = true to light it. 
  1202.   '
  1203.   C=BUT-1
  1204.   If BUT<9
  1205.     BUT=BUT-(LIT=False)*8 : Rem Get right icon (alight or dark)
  1206.   Else 
  1207.     BUT=8+BUT-(LIT=False)*3
  1208.   End If 
  1209.   '
  1210.   Paste Icon BCOORDS(C,1),BCOORDS(C,2),BUT
  1211.   '
  1212.   '
  1213. End Proc
  1214. Procedure FAD_ALL[W]
  1215.   For T=1 To W
  1216.     Colour Back(Colour(0))
  1217.     View 
  1218.     Wait Vbl 
  1219.   Next 
  1220. End Proc
  1221. Procedure RESET_MOUSE_AREA
  1222.   Limit Mouse 128,39 To 447,291
  1223. End Proc
  1224. Procedure INIT_DISPLAY
  1225.   Auto View Off : Rem                  Prevent Amos from turning screen on!
  1226.   Hide 
  1227.   Screen Open 0,640,256,16,Hires : Rem Open a 16 colour medium res screen 
  1228.   Screen Hide 0 : Rem                  Make the screen go blank while it is set up.    
  1229.   Unpack 5 To 0 : Rem                  Restore packed screen from bank 5 
  1230.   Flash Off 
  1231.   Curs Off 
  1232.   Set Curs 192,192,192,192,192,192,192,192 : Rem Describe cursor bit pattern (shape)
  1233.   For COUNT=0 To 15
  1234.     C0LS(COUNT)=Colour(COUNT) : Rem   Record colours in array C0LS 
  1235.   Next 
  1236.   Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 : Rem Set palette to black before fade 
  1237.   Colour Back Colour(0)
  1238.   Screen Display 0,,37,,
  1239.   RESET_MOUSE_AREA
  1240.   If CTV
  1241.     Screen Display 0,140,37,640,200
  1242.   End If 
  1243.   Auto View On : Rem                   Turn screen on.
  1244.   Screen 0
  1245.   Screen Show 0
  1246.   ' Smooth fades, courtesy Mr. Amos! 
  1247.   Fade 2,$48A : Rem                    First the background.     
  1248.   FAD_ALL[32] : Rem                    Ensure border is faded too.     
  1249.   Wait 3
  1250.   Fade 3,,,,,,,,,,$FF0 : Rem           Next the power light comes on.   
  1251.   Wait 30
  1252.   Fade 3,,,,,,,,,,$F00 : Rem           Next the power light comes on.   
  1253.   Wait 25
  1254.   ' And finally, everything is lit!
  1255.   Fade 2,C0LS(0),C0LS(1),C0LS(2),C0LS(3),C0LS(4),C0LS(5),C0LS(6),C0LS(7),C0LS(8),C0LS(9),C0LS(10),C0LS(11),C0LS(12),C0LS(13),C0LS(14),C0LS(15)
  1256.   Show 
  1257.   Wait 10
  1258. End Proc
  1259. Procedure CLR_DISPLAY
  1260.   Paper 14
  1261.   For COUNT=1 To 19
  1262.     Locate FD(COUNT,1),FD(COUNT,2)
  1263.     Print Space$(FD(COUNT,3))
  1264.   Next 
  1265.   UDATE_CN
  1266. End Proc
  1267. '
  1268. ' ------------ 
  1269. ' Main program 
  1270. ' ------------ 
  1271. '
  1272. CTV=Ntsc
  1273. INIT_DISPLAY
  1274. Reserve Zone 11
  1275. ICON_ZONES
  1276. Request Off 
  1277. Make Icon Mask : Rem                   All icons have colour 0 transparent. 
  1278. Get Block 2,0,0,16,1 : Rem             Initial block for stars. 
  1279. Every 3 Proc STAR : Rem                every 3/50ths of a sec update the   
  1280. '                                      flashing star highlight 
  1281. T=True
  1282. Screen Offset 0,0,0
  1283. Repeat 
  1284.    Every On 
  1285.    If MBP : Rem                         Drop through loop if mouse button pressed
  1286.       MBP=False
  1287.    Else 
  1288.       Repeat : Rem                       Wait for the left mouse button.  
  1289.          K$=Inkey$
  1290.          '
  1291.          '     AMERICAN NTSC bodge fix to scroll control panel into view  
  1292.          '
  1293.          If CTV
  1294.             If Y Mouse>CHNGETV_SCROLLSTART and T
  1295.                T=False
  1296.                For COUNT=0 To SCRHEIGHT Step 14
  1297.                   Wait Vbl 
  1298.                   Screen Offset 0,,COUNT
  1299.                Next 
  1300.                Y Mouse=CHNGETV_SCROLLSTART-SCRHEIGHT+10
  1301.             End If 
  1302.             If Y Mouse<CHNGETV_SCROLLSTART-SCRHEIGHT and Not T
  1303.                T=True
  1304.                For COUNT=SCRHEIGHT To 0 Step -14
  1305.                   Wait Vbl 
  1306.                   Screen Offset 0,,COUNT
  1307.                Next 
  1308.                Y Mouse=CHNGETV_SCROLLSTART-10
  1309.             End If 
  1310.          End If 
  1311.          '
  1312.       Until Mouse Click=1 or(K$<>"")
  1313.    End If 
  1314.    Every Off 
  1315.    MBOX=0 : Rem                         Handle keyboard input: 
  1316.    If K$<>""
  1317.       If K$="d" and Key Shift=128
  1318.          DEL_CARD
  1319.       Else 
  1320.          If K$="c" and Key Shift=128
  1321.             Bell 
  1322.             CLEAR_CARDS
  1323.          Else 
  1324.             If K$="p"
  1325.                If Key Shift=128
  1326.                   PCARD[False]
  1327.                Else 
  1328.                   If Key Shift=8
  1329.                      PCARD[True]
  1330.                   End If 
  1331.                End If 
  1332.             Else 
  1333.                If K$=Chr$(29) and Key Shift=8
  1334.                   MBOX=3
  1335.                Else 
  1336.                   If K$=Chr$(28) and Key Shift=8
  1337.                      MBOX=4
  1338.                   Else 
  1339.                      If K$=Chr$(29)
  1340.                         MBOX=1
  1341.                      Else 
  1342.                         If K$=Chr$(28)
  1343.                            MBOX=2
  1344.                         Else 
  1345.                            If K$="n"
  1346.                               MBOX=5
  1347.                            Else 
  1348.                               If K$="l" and Key Shift=128
  1349.                                  MBOX=9
  1350.                               Else 
  1351.                                  If K$="s" and Key Shift=128
  1352.                                     MBOX=10
  1353.                                  Else 
  1354.                                     If K$="q" and Key Shift=128
  1355.                                        MBOX=11
  1356.                                     End If 
  1357.                                  End If 
  1358.                               End If 
  1359.                            End If 
  1360.                         End If 
  1361.                      End If 
  1362.                   End If 
  1363.                End If 
  1364.             End If 
  1365.          End If 
  1366.       End If 
  1367.    Else 
  1368.       MBOX=Mouse Zone
  1369.    End If 
  1370.    Clear Key 
  1371.    If MBOX>0
  1372.       On MBOX Proc PREV_CARD,NXT_CARD,FIRST_CARD,LAST_CARD,NEW_CARD,DUMMY,DUMMY,FIND,_LOAD,_SAVE
  1373.       If MBOX>=6 and MBOX<=7
  1374.          S0RT[MBOX-7]
  1375.       End If 
  1376.       If MBOX=11
  1377.          If UNSAVED
  1378.             MESSAGE[M$,"Yes","No",True]
  1379.          Else 
  1380.             MESSAGE["Quit File O' Facts. Are you sure?","Yes","No way",True]
  1381.          End If 
  1382.          QUIT=Param
  1383.       End If 
  1384.    Else 
  1385.       If K$=""
  1386.          MX=X Text(X Screen(X Mouse))
  1387.          MY=Y Text(Y Screen(Y Mouse))
  1388.          IS_IT_A_FIELD[MX,MY]
  1389.          If Param>0
  1390.             ED_CARD[True,Param-1]
  1391.          End If 
  1392.       End If 
  1393.    End If 
  1394.    K$=""
  1395. Until QUIT
  1396. Every Off 
  1397. Fade 3,,,,,,,,,,0 : Rem                Turn off power light. 
  1398. Wait 40
  1399. ' fade to blue 
  1400. Fade 2,1162,1162,1162,1162,1162,1162,1162,1162,1162,1162,1162,1162,1162,1162,1162,1162
  1401. Wait 40
  1402. Fade 2 : Rem                           Fade to black
  1403. FAD_ALL[40]
  1404. Edit